use v6;
unit module LR1;

class LR1Term is export {
	has $.name;
	has $.isleft;
}

class LR1Grammar is export {
	has $.left;
	has @.right;
	has $.lineno;
	has $.level;
	has $.rank_right;

	method to_text() {
		"{$.left} -> {@.right.join(' ')}"
	}
}

role LR1Token is export {
	has Str $.cata is rw;
	has Match $.match is rw;

	method lineno () {
		return -1 if ! $.match;
		my $c = 1;
		if $.match.orig.substr(0..^$.match.from) ~~ m:g/("\n")/ {
			$c = $/.elems + 1
		}
		return $c
	}
}

sub lr1token($obj, :$cata, :$match) is export {
	my $str = $obj ~~ Str ?? $obj !! $obj.Str;
	my $mx = $str but LR1Token;
	$mx.cata = $cata // $str;
	$mx.match = $match // ($obj ~~ Match ?? $obj !! Nil);
	$mx
}

class LR1Yacc is export {
	has %.levels;
	has %.level_map;
	has %.rights;
	has %.ranks;
	has @.grammars;

	method make_grammar($lno, $left, @right) {
		sub make_right(@rs) {
			@(do for @rs {
					 if /^ "\"" (.*) "\"" $/ {
						 $0.Str
					 } else {
						 $_
					 }
			})
		}
		sub make_level($key) {
			%.levels{$key} // die "level {$key} does not  exists"
		}
		
		when @right[*-1] eq '&&' {
			@.grammars.push: LR1Grammar.new(lineno => $lno,
											left => $left,
											right => make_right(@right[0..^*-1]),
											:rank_right)
		}
		when @right.elems > 2 && @right[*-2] eq '&' {
			@.grammars.push: LR1Grammar.new(lineno => $lno,
											left => $left,
											right => make_right(@right[0..^*-2]),
											level => make_level(@right[*-1]))
		}
		when @right.elems > 2 && @right[*-2] eq '&&' {
			@.grammars.push: LR1Grammar.new(lineno => $lno,
											left => $left,
											right => make_right(@right[0..^*-2]),
											level => make_level(@right[*-1]),
										    :rank_right)
		}
		default {
			@.grammars.push: LR1Grammar.new(lineno => $lno,
											left => $left,
											right => make_right(@right))
		}
	}

	method set-grammar(LR1Yacc:U: $src) {
		my $self = LR1Yacc.new;
		my $lno = 0;
		my $last_left;
		for |$src -> $ln {
			$lno++ ;
			if $ln ~~ /^ (.*) (\s+ '#' .*)?/ {
				my $rn = $0;
				given $rn {
					when /^ \s* (\S+) \s* ['->' | '='] \s* ((\S+) (\s+ \S+)*) \s* $/ {
						my $left = $0.Str;
						my @right = $1 ~~ m:g/(\S+)/;
						given $left {
							when '%levels' {
								for @right.kv -> $k, $v {
									$self.levels{$v} = $k + 1;
								}
							}
							when '%rights' {
								for @right.kv -> $k, $v {
									$self.rights{$v} = $k
								}
							}
							when '%ranks' {
								for @right.kv -> $k, $v {
									$self.ranks{$v} = $k
								}
							}
							default {
								when $self.levels{$left}:exists {
									$self.level_map{$_} = $self.levels{$left} for @right
								}
								default {
									$self.make_grammar: $lno, $left, @right>>.Str;
									$last_left = $left;
								}
							}
						}
					}
					when /^ \s* '|' \s* ((\S+) (\s+ \S+)*) \s* $/ {
						my @right = $0 ~~ m:g/(\S+)/;
						$self.make_grammar($lno, $last_left, @right>>.Str) if $last_left
					}
				}
			}
		}
		$self
	}

	has $.top is rw;
	has $.grammar_top is rw; ## 顶级文法
	has %.name_map;
	has %.termer;
	has @.states;

	class Termer {
		has $.name;
		has $.isleft;
		has $.first is rw;
		has @.grammars;
		has %.states;
	}
	
	method !prepare() {
		## 分类终结符
		my %lefts = %();
		for @.grammars -> $g {
			%lefts{$g.left} = 0;
		}
		for @.grammars -> $g {
			for $g.right -> $i {
				if %lefts{$i}:exists {
					%lefts{$i}++ ;
				}
			}
		}
		
		## 找到lefts里为0的非终结符，为TOP
		for %lefts.kv -> $k, $v {
			my $id = 0;
			if $v == 0 {
				if $.top {
					die "TOP ({$.top}, {$k}) more then one"
				}
				$.top = $k;
			}
			%.termer{$k} = Termer.new:
						 name => $k,
						 isleft => True,
						 first => %();
		}
		if ! $.top {
			for %lefts.kv -> $k, $v {
				put "$k => $v"
			}
			die "TOP not found"
		}
		for @.grammars -> $g {
			%.termer{$g.left}.grammars.push: $g;
			for $g.right -> $i {
				if %.termer{$i}:!exists {
					%.termer{$i} = Termer.new:
								 name => $i,
								 isleft => False,
								 first => %();
				}
			}
		}

		$.grammar_top = (@.grammars.grep: { $_.left eq $.top })[0];
	}

	method !firsts() {
		loop {
			my $x = 0;
			for %.termer.values -> $tl {
				if $tl.isleft {
					for $tl.grammars -> $g {
						my $r = $g.right[0];
						my $tr = %.termer{$r};
						if $tr.isleft {
							my $new = %(|$tl.first.kv, |$tr.first.kv);
							if $new.elems != $tl.first.elems {
								$tl.first = $new;
								$x = 1;
							}
						} else {
							if $tl.first{$r}:!exists {
								$tl.first.append: $r => 0;
								$x = 1;
							}
						}
					}
				}
			}
			last if $x == 0;
		}
	}

	class Gramm {
		has Str  $.text;
		has LR1Grammar $.gramm;
		has Int  $.dot;
		has Str  $.follow;
	}

	sub make_grammar_text(LR1Grammar $g,
						  Int $dot,
						  Str $follow) {
		q:c!{$g.left}/{$g.right.join(',')}/{$dot}/{$follow}!
	}

	class State {
		has $.text is rw;
		has $.index is rw;
		
		has $.by;
		has %.gramm_set;
		has @.to;
		has %.actions;
		
		method gramm(LR1Grammar $g, Int $dot, Str $follow) {
			my $text = make_grammar_text($g, $dot, $follow);
			if %.gramm_set{$text}:exists {
				Nil
			} else {
				my $new = Gramm.new: text => $text, gramm => $g, dot => $dot, follow => $follow;
				%.gramm_set{$text} = $new;
				$new
			}
		}

		method make_text() {
			$.text = %.gramm_set.keys.sort.join('||')
		}
	}

	method !reinsert(State $s) {
		my $cont = $.termer{$s.by}.states;
		$cont{$s.text}:delete;
		$s.make_text;
		$cont{$s.text} = $s
	}

	method !top_state() {
		my $s = State.new: by => $.top;
		$s.gramm: $.grammar_top, 0, $s.by;
		my $tl = %.termer{$s.by};
		$s.make_text;
		$tl.states{$s.text} = $s;
		$s.index = $.states.elems;
		$.states.push: $s;
		$s
	}

	method !closure(State $I) {
		my @gs = eager $I.gramm_set.values;
		my $i = 0;
		while $i < @gs.elems {
			my $g = @gs[$i];
			if $g.dot < $g.gramm.right.elems {
				my $B = $g.gramm.right[$g.dot];
				my $ib = %.termer{$B};

				my $first;
				if $B {
					my $ib = $.termer{$B};
					my $beta = $g.gramm.right[$g.dot + 1];
					my $first;
					if $beta {
						$first = %.termer{$beta}.first
					} else {
						$beta = $g.follow;
					}
					for $ib.grammars -> $X {
						if $first && $first.elems != 0 {
							for $first.keys -> $k {
								my $n = $I.gramm($X, 0, $k);
								@gs.push($n) if $n
							}
						} else {
							my $n = $I.gramm($X, 0, $beta);
							@gs.push($n) if $n
						}
					}
				}
			}
			$i++ ;
		}
		$I
	}

	method !Goto(State $I, Str $X) {
		my $J = State.new: by => $X;
		for $I.gramm_set.values -> $g {
			my $r = $g.gramm.right[$g.dot];
			if $r && $r eq $X {
				$J.gramm: $g.gramm, $g.dot + 1, $g.follow;
			}
		}
		self!closure: $J;
		
		my $ic = $.termer{$X};
		$J.make_text;
		if $ic.states{$J.text}:!exists {
			$J.index = $.states.elems;
			$ic.states{$J.text} = $J;
			$.states.push: $J;
			$J
		} else {
			$ic.states{$J.text}
		}
	}

	method !items() {
		self!reinsert: self!closure(self!top_state());
		my $i = 0;
		while $i < @.states.elems {
			my %cs = %();
			my $I = @.states[$i];
			for $I.gramm_set.values.sort({$^a.text cmp $^b.text}) -> $g {
				my $X = $g.gramm.right[$g.dot];
				if $X && (%cs{$X}:!exists) {
					%cs.append: $X => 0;
					my $gt = self!Goto: $I, $X;
					$I.to.push: $gt;
				}
			}
			$i++ ;
		}
	}

	method !no-goto(State $s, $flw) {
		for $s.to -> $to {
			return False if $to.by eq $flw 
		}
		return True
	}

	method !pri_rank($g --> Int) {
		my $flw = $g.follow;
		return False if %.ranks{$flw}:exists;

		my $f_level = $.level_map{$flw} // 0;
		my $f_right = $.rights{$flw} ?? 1 !! 0;		

		my $g_level = $g.gramm.level // 0;
		my $g_right = $g.gramm.rank_right ?? 1 !! 0;
		
		if $g_level == 0 && $g_right == 0 && $g.dot >= 2 {
			my $x = $g.gramm.right[$g.dot - 2];
			$g_level = $.level_map{$x} // 0;
			$g_right = $.rights{$x} ?? 1 !! 0;
		}
		if $g_level == $f_level {
			return $g_right != 0
		}
		return $g_level > $f_level
	}

	method !action_rank(State $state, $g) {
		my $val = $state.actions{$g.follow};
		if $val {
			if $val !=== $g {
				die "conflict Rank s:{$state.index} by {$g.follow}"
			}
		} else {
			$state.actions{$g.follow} = $g
		}
	}

	method !action_goto(State $state, State $to) {
		my $val = $state.actions{$to.by};
		if $val and $val !=== $to {
			return if $val ~~ Gramm;
			die "conflict Goto s:{$state.index},{$val.index} by {$to.by}"
		} else {
			$state.actions{$to.by} = $to
		}
	}

	method !actions() {
		for @.states.kv -> $no, $state {
			for $state.gramm_set.values -> $g {
				if ! $g.gramm.right[$g.dot] {
					if self!no-goto($state, $g.follow) || $g.dot <= 1 || self!pri_rank($g) {
						self!action_rank: $state, $g
					}
				}
			}
			for $state.to -> $to {
				self!action_goto: $state, $to
			}
			if $state.actions.elems == 0 {
				$*ERR.put: "warning: state {$no} no actions"
			}
		}
	}
	
	method analysis() {
		self!prepare;
		self!firsts;
		self!items;
		self!actions;
	}

	method dump-grammar-states() {
		for @.states -> $t {
			print "{$t.index}: {$t.by} \{ ", "\n";
			for $t.gramm_set.values.sort({$^a.text cmp $^b.text}) -> $gs {
				print "{$gs.gramm.left} -> ";
				for $gs.gramm.right.kv -> $i, $r {
					if ($i == $gs.dot) {
						print ". ";
					}
					print "{$r} ";
				}
				print "\t\t, {$gs.follow eq $.top ?? '$' !! $gs.follow}\n";
			}
			print "actions:\n";
			for $t.actions.kv -> $k, $a {
				if $a ~~ Gramm {
					print "\t", "rank(by {$a.follow}): ", $a.gramm.to_text, "\n"
				} else {
					print "\t", "goto(by {$a.by}): {$a.index}", "\n"
				}
			}
			print "\} => ";
			for $t.to -> $n {
				print("{$n.index} ");
			}
			print "\n";
		}
	}

	method get-actions-data() {
		my %gramms = do for @.grammars -> $g {
			$g.to_text => [ $g.left, |$g.right ]
		}
		my @data = ();
		for @.states -> $v {
			my $i = %();
			for $v.actions.kv -> $k, $a {
				if $a ~~ Gramm {
					$i.append: $k => $a.gramm.to_text
				} else {
					$i.append: $k => $a.index
				}
			}
			@data.push: $i
		}
		%(grammars => %gramms, data => @data,
		  top => $.top, gtop => $.grammar_top.to_text)
	}
}

class LR1Compiling is export {
	method syntax-analysis($table, $src0, $rank) {
		my $src = $src0 ~~ Iterator ?? $src0 !! $src0.iterator;
		my $grammars = $table<grammars>;
		my $top = $table<top>;
		my $data = $table<data>;
		
		my @status = ();
		my @tokens = ();
		my $cursor = Nil;
		
		if @status.elems == 0 {
			$cursor := $src.pull-one;
			if $cursor =:= IterationEnd {
				return Nil
			} elsif $cursor !~~ LR1Token {
				$cursor := lr1token($cursor)
			}
			@status.push: 0
		}

		sub agc ($sl, $c) {
			$data[$sl]{$c.cata};
		}

		loop {
			my $c;
			my $s;
			loop { ### 为了以后支持错误处理
				$s = @status[*-1];
				$c = agc($s, $cursor);
				if !$c {
					die "syntax-error {$cursor}({$cursor.cata} L:{$cursor.lineno}) ==> state($s): {$data[$s].keys.join(' ')}"
				} else {
					last
				}
			}

			if $c ~~ Int {
				@status.push: $c;
				@tokens.push: $cursor;
				$cursor := $src.pull-one;
				if $cursor =:= IterationEnd {
					$cursor := lr1token($top);
				} elsif $cursor !~~ LR1Token {
					$cursor := lr1token($cursor)
				}
			} else {
				my $g = $grammars{$c};
				if !$g {
					die "grammar [ {$c} ] not exist"
				}
				my $rc = $g.elems - 1;
				@status.splice: @status.elems - $rc;
				my @syms = @tokens.splice: @tokens.elems - $rc; 
				
				@tokens.push: lr1token($g[0]);

				$rank.($c, $g, @syms);			
				return True if $g[0] eq $top;

				my $j = @status[*-1];
				my $k = agc($j, lr1token($g[0]));
				@status.push: $k
			}
		}
	}
	
	method make-rank-actions($actions) is export {
		my $def = $actions{' '};
		return sub ($gn, $g, @syms) {
			my $f = $actions{$gn} // $def;
			$f.($gn, $g, @syms) if $f;
		}
	}
}


